home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / outline.tk < prev    next >
Encoding:
Text File  |  1995-11-06  |  4.9 KB  |  164 lines

  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # Outlines serve 2 purposes.
  8. # 1) The function as a container to hold the resize handles
  9. # 2) They "block out" the parts of grid lines for widgets that span
  10. #    multiple rows or columns
  11.  
  12. # Outlines are expensive to maintain, so create
  13. # them only if a widget has a row or column span > 1 *OR* the widget
  14. # is currently selected - so the resize handles will show.
  15. # This should be re-coded to avoid using variable traces, which tend to
  16. # be hard to debug, and can have subtle side effects
  17.  
  18. # the outline is drawn as a child of the frame the widget is managed in, so
  19. # it is easy to find all outlines for a given frame, in case we need to
  20. # change their color.
  21.  
  22. # associate an outline with a widget.
  23. # this sets a trace on the widgets rowspan and columnspan array elements
  24. # delete any old trace (if any) just in case we left one around
  25.  
  26. proc outline_create {name} {
  27.     global $name
  28.     dputs "Creating trace for $name"
  29.     trace vdelete ${name}(rowspan) w outline_trace
  30.     trace vdelete ${name}(columnspan) w outline_trace
  31.     trace variable ${name}(rowspan) w outline_trace
  32.     trace variable ${name}(columnspan) w outline_trace
  33. }
  34.  
  35. # remove the variable trace from an outline (not used)
  36.  
  37. proc outline_remove {name} {
  38.     global $name
  39.     dputs "Removing trace for $name"
  40.     trace vdelete ${name}(rowspan) w outline_trace
  41.     trace vdelete ${name}(columnspan) w outline_trace
  42. }
  43.  
  44. # create or destroy an outline for a window
  45. # This only happens as a result of a variable trace
  46. # and when outline_inhibit is TRUE
  47. # If the variable is referenced via an "upvar" alias: don't
  48. #   name:   The widget that needs an outline
  49. #   args:    Extra stuff passed in via trace that we don't need
  50.  
  51.  
  52. set Outline_inhibit 0
  53. proc outline_trace {name args} {
  54.     global Current Outline_inhibit
  55.     upvar $name data
  56.     dputs "Trace $name: $args"
  57.     if {$Outline_inhibit || ![info exists data]} return
  58.     
  59.     # This check shouldn't be needed
  60.     if {![info exists data(columnspan)] || \
  61.         ![info exists data(rowspan)]} {
  62.         dputs "-OOPS $name"
  63.         return
  64.     }
  65.  
  66.     if {$data(rowspan) > 1 || \
  67.             $data(columnspan) > 1 || \
  68.             $Current(widget) == ".can.f.$data(pathname)"} {
  69.         outline_activate $data(pathname)
  70.     } else {
  71.         outline_destroy $data(pathname)
  72.     }
  73. }
  74.  
  75. # actually make the outline for a window
  76. # outline names end in "_outline", and are children of the widget's master
  77. #  name:  The name of the widget to make an outline for
  78.  
  79. proc outline_activate {name} {
  80.     upvar #0 $name data
  81.     set outline .can.f$data(master).${name}_outline
  82.     catch {frame $outline -bg [.can.f$data(master) cget -bg]}
  83.     dputs $name $outline
  84.  
  85.     # fix the stacking order - only need for "main" frame    
  86.     # this should be fixed so the main frame is not a special case
  87.     # for sub-frames, the outlines already "stick" to the masters
  88.     # so we get the correct stacking order for free.
  89.  
  90.     if {$data(master) == ""} {
  91.         lower $outline .can.f.$name
  92.         catch "lower $outline .can.f.${name}_highlight"
  93.     }
  94. }
  95.  
  96. # destroy the outline, and any resize handles
  97. # The resize handles will be "placed" in the outline, but
  98. # they are not children of the outline
  99.  
  100. proc outline_destroy {name} {
  101.     upvar #0 $name data
  102.     set outline .can.f$data(master).${name}_outline
  103.     dputs $outline
  104.     if {[winfo exists $outline]} {
  105.         eval "destroy [place slaves $outline] $outline"
  106.     } else {
  107.         dputs "non-existant outline"
  108.     }
  109. }
  110.  
  111. # update the highlight regions for a frame
  112. # This is still broken.
  113. # This is called whenever the table geometry of a master changes, which
  114. # causes the outline's size and location to change
  115.  
  116. # This finds too many outlines when the master is the toplevel frame
  117.  
  118. proc outline_update {master} {
  119.     upvar #0 geom:$master data
  120.     set list [info commands $master.*_outline]
  121.     dputs $master $list
  122.  
  123.     regsub -all _outline [info commands $master.*_outline] {} list
  124.     foreach win $list {
  125.         set parent .can.f.[lindex [split $win .] end]
  126.         if {[info exists data($parent)]} {
  127.             eval "place ${win}_outline $data($parent)"
  128.         } else {
  129.             dputs "  AArgg! no $win in geom:$master !!"
  130.         }
  131.     }
  132. }
  133.  
  134. # color all of the outlines to match the background color of its master
  135. # Outlines must always be the color of their masters, so they are "invisible",
  136. # except where they cover piece of grid lines.
  137.  
  138. proc outline_color {master} {
  139.     set color [$master cget -bg]
  140.     dputs $master $color
  141.     foreach win [info commands $master.*_outline] {
  142.         $win configure -bg $color
  143.     }
  144. }
  145.  
  146. # forget the outlines (un-pack them)
  147. # It might be faster to unmap all of the outlines, re-layout the grids,
  148. # then re-map all of the outlines, instead of causing a flood of configure
  149. # events caused by the resize handles.
  150.  
  151. proc outline_forget {{master .can.f}} {
  152.     set list [info commands $master.*_outline] 
  153.     foreach i $list {
  154.         place forget $i
  155.     }
  156. }
  157.  
  158. # inhibit the effect of the outline variable trace temporarily
  159.  
  160. proc outline_inhibit {value} {
  161.     global Outline_inhibit
  162.     set Outline_inhibit $value
  163. }
  164.